SSPS: Personality Dynamics
Emorie D Beck
2022-07-06
1 Workspace
1.1 Packages
pkg <- c("knitr", "lme4", "psych", "EGAnet", "tidymodels", "vip", "qgraph", "RColorBrewer", "lubridate", "broom", "broom.mixed", "plyr", "tidyverse")
if(any(!pkg %in% rownames(installed.packages()))){
pkg <- pkg[!pkg %in% rownames(installed.packages())]
lapply(pkg, install.packages)
}
library(knitr) # rmarkdown
library(lme4) # estimate mlms## Loading required package: Matrixlibrary(psych) # psychometrics, descriptives, structural models, and more
library(EGAnet) # exploratory graph analysis## [1;m[4;m
## EGAnet (version 1.1.0)[0m[0m
## For help getting started, type browseVignettes("EGAnet")
##
## For bugs and errors, submit an issue to <https://github.com/hfgolino/EGAnet/issues>library(RColorBrewer)
library(vip)##
## Attaching package: 'vip'## The following object is masked from 'package:utils':
##
## vilibrary(qgraph)
library(lubridate)##
## Attaching package: 'lubridate'## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, unionlibrary(broom)
library(broom.mixed)
library(plyr) # data wrangling
library(tidyverse) # data wrangling, cleaning, and more## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──## ✔ ggplot2 3.3.6 ✔ purrr 0.3.4
## ✔ tibble 3.1.7 ✔ dplyr 1.0.9
## ✔ tidyr 1.2.0 ✔ stringr 1.4.0
## ✔ readr 2.1.2 ✔ forcats 0.5.1## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ ggplot2::%+%() masks psych::%+%()
## ✖ ggplot2::alpha() masks psych::alpha()
## ✖ dplyr::arrange() masks plyr::arrange()
## ✖ lubridate::as.difftime() masks base::as.difftime()
## ✖ purrr::compact() masks plyr::compact()
## ✖ dplyr::count() masks plyr::count()
## ✖ lubridate::date() masks base::date()
## ✖ tidyr::expand() masks Matrix::expand()
## ✖ dplyr::failwith() masks plyr::failwith()
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::id() masks plyr::id()
## ✖ lubridate::intersect() masks base::intersect()
## ✖ dplyr::lag() masks stats::lag()
## ✖ dplyr::mutate() masks plyr::mutate()
## ✖ tidyr::pack() masks Matrix::pack()
## ✖ dplyr::rename() masks plyr::rename()
## ✖ lubridate::setdiff() masks base::setdiff()
## ✖ dplyr::summarise() masks plyr::summarise()
## ✖ dplyr::summarize() masks plyr::summarize()
## ✖ lubridate::union() masks base::union()
## ✖ tidyr::unpack() masks Matrix::unpack()library(tidymodels) # framework for estimating ML and other models## ── Attaching packages ────────────────────────────────────── tidymodels 0.2.0 ──## ✔ dials 1.0.0 ✔ rsample 1.0.0
## ✔ infer 1.0.2 ✔ tune 0.2.0
## ✔ modeldata 0.1.1 ✔ workflows 0.2.6
## ✔ parsnip 1.0.0 ✔ workflowsets 0.2.1
## ✔ recipes 0.2.0 ✔ yardstick 1.0.0## ── Conflicts ───────────────────────────────────────── tidymodels_conflicts() ──
## ✖ ggplot2::%+%() masks psych::%+%()
## ✖ scales::alpha() masks ggplot2::alpha(), psych::alpha()
## ✖ dplyr::arrange() masks plyr::arrange()
## ✖ purrr::compact() masks plyr::compact()
## ✖ dplyr::count() masks plyr::count()
## ✖ scales::discard() masks purrr::discard()
## ✖ tidyr::expand() masks Matrix::expand()
## ✖ dplyr::failwith() masks plyr::failwith()
## ✖ dplyr::filter() masks stats::filter()
## ✖ recipes::fixed() masks stringr::fixed()
## ✖ dplyr::id() masks plyr::id()
## ✖ dplyr::lag() masks stats::lag()
## ✖ dplyr::mutate() masks plyr::mutate()
## ✖ tidyr::pack() masks Matrix::pack()
## ✖ dplyr::rename() masks plyr::rename()
## ✖ yardstick::spec() masks readr::spec()
## ✖ recipes::step() masks stats::step()
## ✖ dplyr::summarise() masks plyr::summarise()
## ✖ dplyr::summarize() masks plyr::summarize()
## ✖ tidyr::unpack() masks Matrix::unpack()
## ✖ recipes::update() masks Matrix::update(), stats::update()
## • Dig deeper into tidy modeling with R at https://www.tmwr.org1.2 Working Directory
wd <- "https://github.com/emoriebeck"2 Exercise 1: Working with Dynamic Data
2.1 Load in Data
dat <- read_csv(url(sprintf("%s/ESM-structure/blob/main/02-data/02-facet-wide/02-imputed/02-participant-data/csv/221.csv?raw=true", wd))) %>%
separate(Full_Date, c("date", "time"), sep = "[ ]") %>%
mutate(day = as.numeric(mapvalues(date, unique(date), 1:length(unique(date))))) %>%
group_by(day) %>%
mutate(beep = 1:n()) %>%
ungroup() %>%
filter(beep <=4)## Rows: 261 Columns: 17
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): Full_Date
## dbl (16): agreeableness_Compassion, agreeableness_Respectfulness, agreeablen...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.2.2 Pad Missing Observations
dat <- dat %>%
full_join(
crossing(
day = unique(dat$day)
, beep = 1:6
)
) %>%
arrange(day, beep)## Joining, by = c("day", "beep")2.3 Add Lags
dat <- dat %>%
mutate_at(vars(-date, -time, -all_beeps, -day, -beep), lst(lag = lag))
# how many rows without lags?
dat %>%
select(-contains("lag")) %>%
drop_na()# how many rows with lags
dat %>%
select(-date, -time, -all_beeps) %>%
drop_na()3 Exercise 2: Basic Dynamic Indices
3.1 Intraindividual SD (Within-Person Variability)
sd(dat$agreeableness_Compassion, na.rm = T)## [1] 1.128466# the tidy way
dat %>%
select(-contains("lag"), -date, -time, -all_beeps, -day, -beep) %>%
summarize_all(sd, na.rm = T) %>%
pivot_longer(
cols = everything()
, names_to = "var"
, values_to = "sd"
)# base R
sapply(
dat %>%
select(-contains("lag"), -date, -time, -all_beeps, -day, -beep)
, function(x) sd(x, na.rm = T)
)## agreeableness_Compassion agreeableness_Respectfulness
## 1.1284663 0.9935696
## agreeableness_Trust conscientiousness_Organization
## 0.9465205 1.2037256
## conscientiousness_Productiveness conscientiousness_Responsibility
## 1.2332386 1.2143000
## extraversion_Assertiveness extraversion_Energy.Level
## 1.2590248 1.1948333
## extraversion_Sociability neuroticism_Anxiety
## 1.2560469 0.9712506
## neuroticism_Depression neuroticism_Emotional.Volatility
## 0.8784962 1.1528547
## openness_Aesthetic.Sensitivity openness_Creative.Imagination
## 1.1051526 1.0645676
## openness_Intellectual.Curiosity
## 1.04841143.2 Mean Squared Successive Differences (MSSD)
mssd(dat$agreeableness_Compassion)## [1] 0.8981203# the tidy way
dat %>%
select(-contains("lag"), -date, -time, -all_beeps, -day, -beep) %>%
summarize_all(mssd) %>%
pivot_longer(
cols = everything()
, names_to = "var"
, values_to = "mssd"
)# base R
sapply(
dat %>%
select(-contains("lag"), -date, -time, -all_beeps, -day, -beep)
, mssd
)## agreeableness_Compassion agreeableness_Respectfulness
## 0.8981203 0.8653933
## agreeableness_Trust conscientiousness_Organization
## 0.6080334 1.6481133
## conscientiousness_Productiveness conscientiousness_Responsibility
## 1.9799844 1.3155733
## extraversion_Assertiveness extraversion_Energy.Level
## 1.1916452 1.0303352
## extraversion_Sociability neuroticism_Anxiety
## 1.5822683 0.5613855
## neuroticism_Depression neuroticism_Emotional.Volatility
## 0.5373800 1.0765382
## openness_Aesthetic.Sensitivity openness_Creative.Imagination
## 1.1491743 1.1249584
## openness_Intellectual.Curiosity
## 0.66838653.3 Inertia (AR(1) autocorrelations)
cor(dat$agreeableness_Compassion, dat$agreeableness_Compassion_lag, use = "pairwise")## [1] 0.2950876# the tidy way
dat %>%
select(-contains("lag")) %>%
pivot_longer(
cols = c(-date, -time, -all_beeps, -day, -beep)
, names_to = "var"
, values_to = "value"
) %>%
group_by(var) %>%
summarize(ar1 = cor(value, lag(value), use = "pairwise"))3.4 Bringing It All Together
dat %>%
select(-contains("lag")) %>%
pivot_longer(
cols = c(-date, -time, -all_beeps, -day, -beep)
, names_to = "var"
, values_to = "value"
) %>%
group_by(var) %>%
summarize(
sd = sd(value, na.rm = T)
, mssd = mssd(value)
, ar1 = cor(value, lag(value), use = "pairwise")
)4 Exercise 3: Regularized Regression Using Elastic Net and tidymodels
4.1 Load Data
First, we need to load the data and do some feature engineering
load(url(sprintf("%s/behavior-prediction/blob/main/04-data/02-model-data/216_prcrst_psychological_BFI-2_no%%20time.RData?raw=true", wd)))
d4.2 Feature Engineering using Time Stamps
dtime <- d %>%
select(Full_Date) %>%
mutate(Full_Date = ymd_hm(Full_Date)
, wkday = wday(Full_Date, label = T)
, Hour = hour(Full_Date)
, Mon = ifelse(wkday == "Mon", 1, 0)
, Tue = ifelse(wkday == "Tue", 1, 0)
, Wed = ifelse(wkday == "Wed", 1, 0)
, Thu = ifelse(wkday == "Thu", 1, 0)
, Fri = ifelse(wkday == "Fri", 1, 0)
, Sat = ifelse(wkday == "Sat", 1, 0)
, Sun = ifelse(wkday == "Sun", 1, 0)
, morning = ifelse(Hour >= 5 & Hour < 11, 1, 0)
, midday = ifelse(Hour >= 11 & Hour < 17, 1, 0)
, evening = ifelse(Hour >= 5 & Hour < 22, 1, 0)) %>%
## sequential time differences
mutate(tdif = as.numeric(difftime(Full_Date, lag(Full_Date), units = "hours"))) %>%
filter(is.na(tdif) | tdif > 1) %>%
mutate(tdif = as.numeric(difftime(Full_Date, lag(Full_Date), units = "hours"))
, tdif = ifelse(is.na(tdif), 0, tdif)
, cumsumT = cumsum(tdif)) %>%
## timing variables
mutate(linear = as.numeric(scale(cumsumT))
, quad = linear^2
, cub = linear^3
, sin1p = sin(((2*pi)/24)*cumsumT)
, sin2p = sin(((2*pi)/12)*cumsumT)
, cos1p = cos(((2*pi)/24)*cumsumT)
, cos2p = cos(((2*pi)/12)*cumsumT)
) %>%
## keep key variables and reshape
select(Full_Date, Mon:evening, linear:cos2p)
dummy_vars <- c("o_value", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"
, "morning", "midday", "evening")
d <- d %>%
mutate(Full_Date = ymd_hm(Full_Date)) %>%
full_join(dtime) %>%
arrange(Full_Date) %>%
select(-Full_Date) %>%
mutate_at(vars(dummy_vars), factor) %>%
filter(complete.cases(.)); d## Joining, by = "Full_Date"
## Note: Using an external vector in selections is ambiguous. ℹ Use
## `all_of(dummy_vars)` instead of `dummy_vars` to silence this message. ℹ See
## <https://tidyselect.r-lib.org/reference/faq-external-vector.html>. This message
## is displayed once per session.4.3 Set-Up Data
d_split <- initial_time_split(d, prop = 0.75); d_split## <Training/Testing/Total>
## <72/25/97>d_train <- training(d_split); d_traind_test <- testing(d_split); d_test4.4 Set-Up Preprocessing & Recipe in TidyModels
# set up the data and formula
time_vars <- c("cos1p", "cos2p", "cub", "linear", "quad", "sin1p", "sin2p")
mod_recipe <- recipe(
o_value ~ .
, data = d_train
) %>%
step_normalize(all_numeric(), -one_of(time_vars)) %>%
step_dummy(one_of(dummy_vars), -all_outcomes()) %>%
step_zv(all_numeric()) %>%
step_nzv(all_nominal(), unique_cut = 35); mod_recipe## Recipe
##
## Inputs:
##
## role #variables
## outcome 1
## predictor 32
##
## Operations:
##
## Centering and scaling for all_numeric(), -one_of(time_vars)
## Dummy variables from one_of(dummy_vars), -all_outcomes()
## Zero variance filter on all_numeric()
## Sparse, unbalanced variable filter on all_nominal()# set up the model specifications
tune_spec <-
logistic_reg(
penalty = tune()
, mixture = tune()
) %>%
set_engine("glmnet") %>%
set_mode("classification")
# set up the ranges for the tuning functions
elnet_grid <- grid_regular(
penalty()
, mixture()
, levels = 10
)
# set up the workflow: combine modeling spec with modeling recipe
set.seed(345)
elnet_wf <- workflow() %>%
add_model(tune_spec) %>%
add_recipe(mod_recipe)4.5 Run Rolling Origin-Validation
# set up the folds
d_train_cv <- rolling_origin(
d_train,
initial = 15,
assess = 3,
skip = 2,
cumulative = TRUE
)
# run our workflow from above across each fold
elnet_res <-
elnet_wf %>%
tune_grid(
resamples = d_train_cv
, grid = elnet_grid
, control = control_resamples(save_pred = T)
)4.6 Choose the Best Model
# plot the metrics across tuning parameters
elnet_res %>%
collect_metrics() %>%
ggplot(aes(penalty, mean, color = mixture)) +
geom_point(size = 2) +
facet_wrap(~ .metric, scales = "free", nrow = 2) +
scale_x_log10(labels = scales::label_number()) +
scale_color_gradient(low = "gray90", high = "red") +
theme_classic()
# select the best model based on AUC
best_elnet <- elnet_res %>%
# select_best("roc_auc")
select_best("accuracy")
# set up the workflow for the best model
final_wf <-
elnet_wf %>%
finalize_workflow(best_elnet)
# run the final best model on the training data and save
final_elnet <-
final_wf %>%
fit(data = d_train) ## Warning in lognet(xd, is.sparse, ix, jx, y, weights, offset, alpha, nobs, : one
## multinomial or binomial class has fewer than 8 observations; dangerous ground4.7 Run the Model on the Test Set
# run the final fit workflow of the training and test data together
final_fit <-
final_wf %>%
last_fit(d_split) ## ! train/test split: preprocessor 1/1, model 1/1: one multinomial or binomial class has fewer...# final metrics (accuracy and roc)
final_metrics <- final_fit %>%
collect_metrics(summarize = T); final_metrics4.8 Variable Importance
# variable importance
final_var_imp <- final_elnet %>%
pull_workflow_fit() %>%
vi() %>%
slice_max(Importance, n = 10); final_var_imp## Warning: `pull_workflow_fit()` was deprecated in workflows 0.2.3.
## Please use `extract_fit_parsnip()` instead.5 Exercise 4: Dynamic Exploratory Graph Analysis
5.1 Data Set-up
set.seed(5) # set a seed for randomly sampling 10 participants
dat4 <- read_csv(url(sprintf("%s/ESM-structure/blob/main/02-data/02-facet-wide/02-imputed/facet_wide_imp.csv?raw=true", wd))) %>%
filter(complete.cases(.)) %>% # drop missing obs
group_by(SID) %>%
filter(n() >= 30) %>% # keep only people with reasonable #'s of obs
ungroup() %>%
filter(SID %in% sample(unique(.$SID), 10)) %>% # sample 10 px
mutate(wave = 1) %>% # create a wave "grouping" variable
arrange(wave, SID, all_beeps) %>% # reorder the data
select(-Full_Date, -all_beeps) %>% # drop columns that aren't ID, group, or indicators
as.data.frame() # this is important! dynEGA won't work on tibbles## Rows: 23615 Columns: 18
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): SID, Full_Date
## dbl (16): agreeableness_Compassion, agreeableness_Respectfulness, agreeablen...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.5.2 Run the Model
# get numeric ID of the participant ID column
idcol <- which(colnames(dat4) == "SID")
gcol <- which(colnames(dat4) == "wave")
ega_ind <- dynEGA(
data = dat4
, n.embed = 4 # embedding dimension
, tau = 1 # offset for embedding, similar to lag 1
, delta = 4 # time between obs
, level = "individual" # we want individual-level models
, id = idcol # id column position
, group = gcol # group membership, in this case the wave
, use.derivatives = 1 # we want to use 1st order derivatives
, model = "glasso"
, algorithm = "louvain" # the clustering algorithm for structure
, corr = "pearson" # type of correlation
, ncores = 6 # number of cores
); ega_ind##
## Computing derivatives using GLLA...## Estimating the dimensionality structure using EGA...## Level: Individual (Intraindividual Structure)...## done## Number of Cases (individuals):
## [1] 10
## Summary statistics (number of factors/communities):
## Mean: 2.5
## Median: 3
## Min: 0
## Max: 45.3 Explore the Object
First, let’s look at the derivatives. These are stored as a list for each participant:
# derivatives list
names(ega_ind$Derivatives$Estimates)## [1] "ID143" "ID148" "ID162" "ID168" "ID180" "ID186" "ID192" "ID38" "ID63"
## [10] "ID78"# for one px
ega_ind$Derivatives$Estimates$ID143 %>% as_tibble()Or a large data frame:
ega_ind$Derivatives$EstimatesDF %>% as_tibble()Now let’s look at the EGA. These are also stored as a list for each participant.
names(ega_ind$dynEGA)## [1] "ID143" "ID148" "ID162" "ID168" "ID180" "ID186" "ID192" "ID38" "ID63"
## [10] "ID78"names(ega_ind$dynEGA$ID143)## [1] "network" "wc" "n.dim" "cor.data"
## [5] "gamma" "lambda" "dim.variables"Here’s the breakdown:
network= regularized partial correlation matrix.
wc= cluster membership how igraph produces it
n.dim= number of cluster
cor.data= zero-order correlations of the derivatives
mu= hyperparameter for glasso, 0 means it uses BIC for model selectionlambda= regularization shrinkage parameterdim.variables= also cluster membership, but as a data frame
ega_ind$dynEGA$ID143$network## agreeableness_Compassion.Ord1
## agreeableness_Compassion.Ord1 0.00000000
## agreeableness_Respectfulness.Ord1 0.00000000
## agreeableness_Trust.Ord1 0.00000000
## conscientiousness_Organization.Ord1 0.00000000
## conscientiousness_Productiveness.Ord1 0.00000000
## conscientiousness_Responsibility.Ord1 0.00000000
## extraversion_Assertiveness.Ord1 0.00000000
## extraversion_Energy.Level.Ord1 0.00000000
## extraversion_Sociability.Ord1 0.00000000
## neuroticism_Anxiety.Ord1 -0.09646158
## neuroticism_Depression.Ord1 0.00000000
## neuroticism_Emotional.Volatility.Ord1 -0.27236328
## openness_Aesthetic.Sensitivity.Ord1 0.00000000
## openness_Creative.Imagination.Ord1 0.18753804
## openness_Intellectual.Curiosity.Ord1 0.00000000
## agreeableness_Respectfulness.Ord1
## agreeableness_Compassion.Ord1 0.00000000
## agreeableness_Respectfulness.Ord1 0.00000000
## agreeableness_Trust.Ord1 0.04193298
## conscientiousness_Organization.Ord1 0.00000000
## conscientiousness_Productiveness.Ord1 0.00000000
## conscientiousness_Responsibility.Ord1 0.28647794
## extraversion_Assertiveness.Ord1 -0.07296645
## extraversion_Energy.Level.Ord1 0.00000000
## extraversion_Sociability.Ord1 0.00000000
## neuroticism_Anxiety.Ord1 0.02076857
## neuroticism_Depression.Ord1 0.00000000
## neuroticism_Emotional.Volatility.Ord1 0.15807089
## openness_Aesthetic.Sensitivity.Ord1 0.00000000
## openness_Creative.Imagination.Ord1 0.00000000
## openness_Intellectual.Curiosity.Ord1 0.19358344
## agreeableness_Trust.Ord1
## agreeableness_Compassion.Ord1 0.00000000
## agreeableness_Respectfulness.Ord1 0.04193298
## agreeableness_Trust.Ord1 0.00000000
## conscientiousness_Organization.Ord1 0.20654350
## conscientiousness_Productiveness.Ord1 0.00000000
## conscientiousness_Responsibility.Ord1 0.00000000
## extraversion_Assertiveness.Ord1 0.07619860
## extraversion_Energy.Level.Ord1 0.03280065
## extraversion_Sociability.Ord1 0.10078699
## neuroticism_Anxiety.Ord1 0.00000000
## neuroticism_Depression.Ord1 0.00000000
## neuroticism_Emotional.Volatility.Ord1 0.00000000
## openness_Aesthetic.Sensitivity.Ord1 0.23756930
## openness_Creative.Imagination.Ord1 0.26449228
## openness_Intellectual.Curiosity.Ord1 0.00000000
## conscientiousness_Organization.Ord1
## agreeableness_Compassion.Ord1 0.00000000
## agreeableness_Respectfulness.Ord1 0.00000000
## agreeableness_Trust.Ord1 0.20654350
## conscientiousness_Organization.Ord1 0.00000000
## conscientiousness_Productiveness.Ord1 0.00000000
## conscientiousness_Responsibility.Ord1 0.07773032
## extraversion_Assertiveness.Ord1 -0.03120325
## extraversion_Energy.Level.Ord1 0.00000000
## extraversion_Sociability.Ord1 0.00000000
## neuroticism_Anxiety.Ord1 0.00000000
## neuroticism_Depression.Ord1 -0.15393608
## neuroticism_Emotional.Volatility.Ord1 0.00000000
## openness_Aesthetic.Sensitivity.Ord1 0.00000000
## openness_Creative.Imagination.Ord1 0.00000000
## openness_Intellectual.Curiosity.Ord1 0.00000000
## conscientiousness_Productiveness.Ord1
## agreeableness_Compassion.Ord1 0.00000000
## agreeableness_Respectfulness.Ord1 0.00000000
## agreeableness_Trust.Ord1 0.00000000
## conscientiousness_Organization.Ord1 0.00000000
## conscientiousness_Productiveness.Ord1 0.00000000
## conscientiousness_Responsibility.Ord1 0.14513046
## extraversion_Assertiveness.Ord1 0.00000000
## extraversion_Energy.Level.Ord1 0.00000000
## extraversion_Sociability.Ord1 0.00000000
## neuroticism_Anxiety.Ord1 0.00000000
## neuroticism_Depression.Ord1 0.00000000
## neuroticism_Emotional.Volatility.Ord1 0.00000000
## openness_Aesthetic.Sensitivity.Ord1 0.09295943
## openness_Creative.Imagination.Ord1 0.00000000
## openness_Intellectual.Curiosity.Ord1 0.00000000
## conscientiousness_Responsibility.Ord1
## agreeableness_Compassion.Ord1 0.00000000
## agreeableness_Respectfulness.Ord1 0.28647794
## agreeableness_Trust.Ord1 0.00000000
## conscientiousness_Organization.Ord1 0.07773032
## conscientiousness_Productiveness.Ord1 0.14513046
## conscientiousness_Responsibility.Ord1 0.00000000
## extraversion_Assertiveness.Ord1 0.00000000
## extraversion_Energy.Level.Ord1 0.00000000
## extraversion_Sociability.Ord1 -0.02778201
## neuroticism_Anxiety.Ord1 0.00000000
## neuroticism_Depression.Ord1 -0.01266155
## neuroticism_Emotional.Volatility.Ord1 0.00000000
## openness_Aesthetic.Sensitivity.Ord1 0.18373027
## openness_Creative.Imagination.Ord1 -0.05590719
## openness_Intellectual.Curiosity.Ord1 0.40289256
## extraversion_Assertiveness.Ord1
## agreeableness_Compassion.Ord1 0.00000000
## agreeableness_Respectfulness.Ord1 -0.07296645
## agreeableness_Trust.Ord1 0.07619860
## conscientiousness_Organization.Ord1 -0.03120325
## conscientiousness_Productiveness.Ord1 0.00000000
## conscientiousness_Responsibility.Ord1 0.00000000
## extraversion_Assertiveness.Ord1 0.00000000
## extraversion_Energy.Level.Ord1 0.14236089
## extraversion_Sociability.Ord1 0.00000000
## neuroticism_Anxiety.Ord1 0.00000000
## neuroticism_Depression.Ord1 0.00000000
## neuroticism_Emotional.Volatility.Ord1 -0.10840522
## openness_Aesthetic.Sensitivity.Ord1 0.16720137
## openness_Creative.Imagination.Ord1 0.00000000
## openness_Intellectual.Curiosity.Ord1 0.00000000
## extraversion_Energy.Level.Ord1
## agreeableness_Compassion.Ord1 0.00000000
## agreeableness_Respectfulness.Ord1 0.00000000
## agreeableness_Trust.Ord1 0.03280065
## conscientiousness_Organization.Ord1 0.00000000
## conscientiousness_Productiveness.Ord1 0.00000000
## conscientiousness_Responsibility.Ord1 0.00000000
## extraversion_Assertiveness.Ord1 0.14236089
## extraversion_Energy.Level.Ord1 0.00000000
## extraversion_Sociability.Ord1 0.32906737
## neuroticism_Anxiety.Ord1 0.00000000
## neuroticism_Depression.Ord1 0.00000000
## neuroticism_Emotional.Volatility.Ord1 0.00000000
## openness_Aesthetic.Sensitivity.Ord1 0.13128565
## openness_Creative.Imagination.Ord1 0.00000000
## openness_Intellectual.Curiosity.Ord1 0.00000000
## extraversion_Sociability.Ord1
## agreeableness_Compassion.Ord1 0.00000000
## agreeableness_Respectfulness.Ord1 0.00000000
## agreeableness_Trust.Ord1 0.10078699
## conscientiousness_Organization.Ord1 0.00000000
## conscientiousness_Productiveness.Ord1 0.00000000
## conscientiousness_Responsibility.Ord1 -0.02778201
## extraversion_Assertiveness.Ord1 0.00000000
## extraversion_Energy.Level.Ord1 0.32906737
## extraversion_Sociability.Ord1 0.00000000
## neuroticism_Anxiety.Ord1 0.00000000
## neuroticism_Depression.Ord1 -0.11916977
## neuroticism_Emotional.Volatility.Ord1 0.00000000
## openness_Aesthetic.Sensitivity.Ord1 0.00000000
## openness_Creative.Imagination.Ord1 0.00000000
## openness_Intellectual.Curiosity.Ord1 0.00000000
## neuroticism_Anxiety.Ord1
## agreeableness_Compassion.Ord1 -0.09646158
## agreeableness_Respectfulness.Ord1 0.02076857
## agreeableness_Trust.Ord1 0.00000000
## conscientiousness_Organization.Ord1 0.00000000
## conscientiousness_Productiveness.Ord1 0.00000000
## conscientiousness_Responsibility.Ord1 0.00000000
## extraversion_Assertiveness.Ord1 0.00000000
## extraversion_Energy.Level.Ord1 0.00000000
## extraversion_Sociability.Ord1 0.00000000
## neuroticism_Anxiety.Ord1 0.00000000
## neuroticism_Depression.Ord1 0.20650709
## neuroticism_Emotional.Volatility.Ord1 0.04973374
## openness_Aesthetic.Sensitivity.Ord1 0.00000000
## openness_Creative.Imagination.Ord1 0.09460686
## openness_Intellectual.Curiosity.Ord1 0.00000000
## neuroticism_Depression.Ord1
## agreeableness_Compassion.Ord1 0.00000000
## agreeableness_Respectfulness.Ord1 0.00000000
## agreeableness_Trust.Ord1 0.00000000
## conscientiousness_Organization.Ord1 -0.15393608
## conscientiousness_Productiveness.Ord1 0.00000000
## conscientiousness_Responsibility.Ord1 -0.01266155
## extraversion_Assertiveness.Ord1 0.00000000
## extraversion_Energy.Level.Ord1 0.00000000
## extraversion_Sociability.Ord1 -0.11916977
## neuroticism_Anxiety.Ord1 0.20650709
## neuroticism_Depression.Ord1 0.00000000
## neuroticism_Emotional.Volatility.Ord1 0.22624339
## openness_Aesthetic.Sensitivity.Ord1 0.00000000
## openness_Creative.Imagination.Ord1 0.00000000
## openness_Intellectual.Curiosity.Ord1 0.00000000
## neuroticism_Emotional.Volatility.Ord1
## agreeableness_Compassion.Ord1 -0.27236328
## agreeableness_Respectfulness.Ord1 0.15807089
## agreeableness_Trust.Ord1 0.00000000
## conscientiousness_Organization.Ord1 0.00000000
## conscientiousness_Productiveness.Ord1 0.00000000
## conscientiousness_Responsibility.Ord1 0.00000000
## extraversion_Assertiveness.Ord1 -0.10840522
## extraversion_Energy.Level.Ord1 0.00000000
## extraversion_Sociability.Ord1 0.00000000
## neuroticism_Anxiety.Ord1 0.04973374
## neuroticism_Depression.Ord1 0.22624339
## neuroticism_Emotional.Volatility.Ord1 0.00000000
## openness_Aesthetic.Sensitivity.Ord1 -0.14828005
## openness_Creative.Imagination.Ord1 0.00000000
## openness_Intellectual.Curiosity.Ord1 0.00000000
## openness_Aesthetic.Sensitivity.Ord1
## agreeableness_Compassion.Ord1 0.00000000
## agreeableness_Respectfulness.Ord1 0.00000000
## agreeableness_Trust.Ord1 0.23756930
## conscientiousness_Organization.Ord1 0.00000000
## conscientiousness_Productiveness.Ord1 0.09295943
## conscientiousness_Responsibility.Ord1 0.18373027
## extraversion_Assertiveness.Ord1 0.16720137
## extraversion_Energy.Level.Ord1 0.13128565
## extraversion_Sociability.Ord1 0.00000000
## neuroticism_Anxiety.Ord1 0.00000000
## neuroticism_Depression.Ord1 0.00000000
## neuroticism_Emotional.Volatility.Ord1 -0.14828005
## openness_Aesthetic.Sensitivity.Ord1 0.00000000
## openness_Creative.Imagination.Ord1 0.00000000
## openness_Intellectual.Curiosity.Ord1 0.00000000
## openness_Creative.Imagination.Ord1
## agreeableness_Compassion.Ord1 0.18753804
## agreeableness_Respectfulness.Ord1 0.00000000
## agreeableness_Trust.Ord1 0.26449228
## conscientiousness_Organization.Ord1 0.00000000
## conscientiousness_Productiveness.Ord1 0.00000000
## conscientiousness_Responsibility.Ord1 -0.05590719
## extraversion_Assertiveness.Ord1 0.00000000
## extraversion_Energy.Level.Ord1 0.00000000
## extraversion_Sociability.Ord1 0.00000000
## neuroticism_Anxiety.Ord1 0.09460686
## neuroticism_Depression.Ord1 0.00000000
## neuroticism_Emotional.Volatility.Ord1 0.00000000
## openness_Aesthetic.Sensitivity.Ord1 0.00000000
## openness_Creative.Imagination.Ord1 0.00000000
## openness_Intellectual.Curiosity.Ord1 0.00000000
## openness_Intellectual.Curiosity.Ord1
## agreeableness_Compassion.Ord1 0.0000000
## agreeableness_Respectfulness.Ord1 0.1935834
## agreeableness_Trust.Ord1 0.0000000
## conscientiousness_Organization.Ord1 0.0000000
## conscientiousness_Productiveness.Ord1 0.0000000
## conscientiousness_Responsibility.Ord1 0.4028926
## extraversion_Assertiveness.Ord1 0.0000000
## extraversion_Energy.Level.Ord1 0.0000000
## extraversion_Sociability.Ord1 0.0000000
## neuroticism_Anxiety.Ord1 0.0000000
## neuroticism_Depression.Ord1 0.0000000
## neuroticism_Emotional.Volatility.Ord1 0.0000000
## openness_Aesthetic.Sensitivity.Ord1 0.0000000
## openness_Creative.Imagination.Ord1 0.0000000
## openness_Intellectual.Curiosity.Ord1 0.0000000ega_ind$dynEGA$ID143$wc## agreeableness_Compassion.Ord1 agreeableness_Respectfulness.Ord1
## 1 2
## agreeableness_Trust.Ord1 conscientiousness_Organization.Ord1
## 3 1
## conscientiousness_Productiveness.Ord1 conscientiousness_Responsibility.Ord1
## 2 2
## extraversion_Assertiveness.Ord1 extraversion_Energy.Level.Ord1
## 3 3
## extraversion_Sociability.Ord1 neuroticism_Anxiety.Ord1
## 3 1
## neuroticism_Depression.Ord1 neuroticism_Emotional.Volatility.Ord1
## 1 1
## openness_Aesthetic.Sensitivity.Ord1 openness_Creative.Imagination.Ord1
## 3 3
## openness_Intellectual.Curiosity.Ord1
## 2ega_ind$dynEGA$ID143$n.dim## [1] 3ega_ind$dynEGA$ID143$cor.data## agreeableness_Compassion.Ord1
## agreeableness_Compassion.Ord1 1.000000000
## agreeableness_Respectfulness.Ord1 -0.144917198
## agreeableness_Trust.Ord1 0.175232445
## conscientiousness_Organization.Ord1 0.008481247
## conscientiousness_Productiveness.Ord1 -0.090531113
## conscientiousness_Responsibility.Ord1 -0.046594591
## extraversion_Assertiveness.Ord1 0.237280217
## extraversion_Energy.Level.Ord1 0.004410670
## extraversion_Sociability.Ord1 0.092657858
## neuroticism_Anxiety.Ord1 -0.294995032
## neuroticism_Depression.Ord1 -0.187998551
## neuroticism_Emotional.Volatility.Ord1 -0.487960576
## openness_Aesthetic.Sensitivity.Ord1 -0.094449559
## openness_Creative.Imagination.Ord1 0.374580338
## openness_Intellectual.Curiosity.Ord1 0.097445847
## agreeableness_Respectfulness.Ord1
## agreeableness_Compassion.Ord1 -0.14491720
## agreeableness_Respectfulness.Ord1 1.00000000
## agreeableness_Trust.Ord1 0.22733578
## conscientiousness_Organization.Ord1 0.15188072
## conscientiousness_Productiveness.Ord1 0.11508995
## conscientiousness_Responsibility.Ord1 0.59763669
## extraversion_Assertiveness.Ord1 -0.26029253
## extraversion_Energy.Level.Ord1 -0.14374524
## extraversion_Sociability.Ord1 -0.01017949
## neuroticism_Anxiety.Ord1 0.21949054
## neuroticism_Depression.Ord1 0.12950398
## neuroticism_Emotional.Volatility.Ord1 0.35952234
## openness_Aesthetic.Sensitivity.Ord1 0.12089388
## openness_Creative.Imagination.Ord1 -0.17862193
## openness_Intellectual.Curiosity.Ord1 0.54388484
## agreeableness_Trust.Ord1
## agreeableness_Compassion.Ord1 0.1752324446
## agreeableness_Respectfulness.Ord1 0.2273357807
## agreeableness_Trust.Ord1 1.0000000000
## conscientiousness_Organization.Ord1 0.4129780505
## conscientiousness_Productiveness.Ord1 -0.0003581812
## conscientiousness_Responsibility.Ord1 0.0297829522
## extraversion_Assertiveness.Ord1 0.3330555363
## extraversion_Energy.Level.Ord1 0.3247680721
## extraversion_Sociability.Ord1 0.3357442349
## neuroticism_Anxiety.Ord1 0.1144625384
## neuroticism_Depression.Ord1 -0.1850295196
## neuroticism_Emotional.Volatility.Ord1 -0.1172334276
## openness_Aesthetic.Sensitivity.Ord1 0.4898881130
## openness_Creative.Imagination.Ord1 0.4634941426
## openness_Intellectual.Curiosity.Ord1 -0.0180078457
## conscientiousness_Organization.Ord1
## agreeableness_Compassion.Ord1 0.008481247
## agreeableness_Respectfulness.Ord1 0.151880718
## agreeableness_Trust.Ord1 0.412978051
## conscientiousness_Organization.Ord1 1.000000000
## conscientiousness_Productiveness.Ord1 0.097969594
## conscientiousness_Responsibility.Ord1 0.290368424
## extraversion_Assertiveness.Ord1 -0.157668146
## extraversion_Energy.Level.Ord1 0.063739422
## extraversion_Sociability.Ord1 0.115635672
## neuroticism_Anxiety.Ord1 -0.045553558
## neuroticism_Depression.Ord1 -0.350860934
## neuroticism_Emotional.Volatility.Ord1 -0.136406952
## openness_Aesthetic.Sensitivity.Ord1 0.265036100
## openness_Creative.Imagination.Ord1 0.148653742
## openness_Intellectual.Curiosity.Ord1 0.015304397
## conscientiousness_Productiveness.Ord1
## agreeableness_Compassion.Ord1 -0.0905311127
## agreeableness_Respectfulness.Ord1 0.1150899451
## agreeableness_Trust.Ord1 -0.0003581812
## conscientiousness_Organization.Ord1 0.0979695937
## conscientiousness_Productiveness.Ord1 1.0000000000
## conscientiousness_Responsibility.Ord1 0.3777149131
## extraversion_Assertiveness.Ord1 0.1723266074
## extraversion_Energy.Level.Ord1 0.1092529252
## extraversion_Sociability.Ord1 0.0066986477
## neuroticism_Anxiety.Ord1 0.0031348955
## neuroticism_Depression.Ord1 0.0720746796
## neuroticism_Emotional.Volatility.Ord1 -0.1159234988
## openness_Aesthetic.Sensitivity.Ord1 0.3205474808
## openness_Creative.Imagination.Ord1 0.0283903815
## openness_Intellectual.Curiosity.Ord1 0.2713788357
## conscientiousness_Responsibility.Ord1
## agreeableness_Compassion.Ord1 -0.04659459
## agreeableness_Respectfulness.Ord1 0.59763669
## agreeableness_Trust.Ord1 0.02978295
## conscientiousness_Organization.Ord1 0.29036842
## conscientiousness_Productiveness.Ord1 0.37771491
## conscientiousness_Responsibility.Ord1 1.00000000
## extraversion_Assertiveness.Ord1 -0.11824425
## extraversion_Energy.Level.Ord1 -0.06751410
## extraversion_Sociability.Ord1 -0.18150240
## neuroticism_Anxiety.Ord1 0.06733940
## neuroticism_Depression.Ord1 -0.19675725
## neuroticism_Emotional.Volatility.Ord1 -0.08387357
## openness_Aesthetic.Sensitivity.Ord1 0.41801298
## openness_Creative.Imagination.Ord1 -0.21722840
## openness_Intellectual.Curiosity.Ord1 0.68352130
## extraversion_Assertiveness.Ord1
## agreeableness_Compassion.Ord1 0.23728022
## agreeableness_Respectfulness.Ord1 -0.26029253
## agreeableness_Trust.Ord1 0.33305554
## conscientiousness_Organization.Ord1 -0.15766815
## conscientiousness_Productiveness.Ord1 0.17232661
## conscientiousness_Responsibility.Ord1 -0.11824425
## extraversion_Assertiveness.Ord1 1.00000000
## extraversion_Energy.Level.Ord1 0.38047327
## extraversion_Sociability.Ord1 0.10590085
## neuroticism_Anxiety.Ord1 0.01886838
## neuroticism_Depression.Ord1 0.09439041
## neuroticism_Emotional.Volatility.Ord1 -0.35793173
## openness_Aesthetic.Sensitivity.Ord1 0.42602702
## openness_Creative.Imagination.Ord1 0.18766602
## openness_Intellectual.Curiosity.Ord1 0.12597299
## extraversion_Energy.Level.Ord1
## agreeableness_Compassion.Ord1 0.00441067
## agreeableness_Respectfulness.Ord1 -0.14374524
## agreeableness_Trust.Ord1 0.32476807
## conscientiousness_Organization.Ord1 0.06373942
## conscientiousness_Productiveness.Ord1 0.10925293
## conscientiousness_Responsibility.Ord1 -0.06751410
## extraversion_Assertiveness.Ord1 0.38047327
## extraversion_Energy.Level.Ord1 1.00000000
## extraversion_Sociability.Ord1 0.53053567
## neuroticism_Anxiety.Ord1 0.01995421
## neuroticism_Depression.Ord1 -0.02092129
## neuroticism_Emotional.Volatility.Ord1 -0.17666250
## openness_Aesthetic.Sensitivity.Ord1 0.38957794
## openness_Creative.Imagination.Ord1 0.10358889
## openness_Intellectual.Curiosity.Ord1 -0.00652038
## extraversion_Sociability.Ord1
## agreeableness_Compassion.Ord1 0.092657858
## agreeableness_Respectfulness.Ord1 -0.010179487
## agreeableness_Trust.Ord1 0.335744235
## conscientiousness_Organization.Ord1 0.115635672
## conscientiousness_Productiveness.Ord1 0.006698648
## conscientiousness_Responsibility.Ord1 -0.181502397
## extraversion_Assertiveness.Ord1 0.105900846
## extraversion_Energy.Level.Ord1 0.530535673
## extraversion_Sociability.Ord1 1.000000000
## neuroticism_Anxiety.Ord1 -0.206975832
## neuroticism_Depression.Ord1 -0.324131535
## neuroticism_Emotional.Volatility.Ord1 -0.065618517
## openness_Aesthetic.Sensitivity.Ord1 0.143488176
## openness_Creative.Imagination.Ord1 0.147939076
## openness_Intellectual.Curiosity.Ord1 -0.147868651
## neuroticism_Anxiety.Ord1
## agreeableness_Compassion.Ord1 -0.294995032
## agreeableness_Respectfulness.Ord1 0.219490540
## agreeableness_Trust.Ord1 0.114462538
## conscientiousness_Organization.Ord1 -0.045553558
## conscientiousness_Productiveness.Ord1 0.003134896
## conscientiousness_Responsibility.Ord1 0.067339404
## extraversion_Assertiveness.Ord1 0.018868378
## extraversion_Energy.Level.Ord1 0.019954211
## extraversion_Sociability.Ord1 -0.206975832
## neuroticism_Anxiety.Ord1 1.000000000
## neuroticism_Depression.Ord1 0.414310299
## neuroticism_Emotional.Volatility.Ord1 0.316687604
## openness_Aesthetic.Sensitivity.Ord1 0.066432716
## openness_Creative.Imagination.Ord1 0.242009546
## openness_Intellectual.Curiosity.Ord1 0.148926682
## neuroticism_Depression.Ord1
## agreeableness_Compassion.Ord1 -0.18799855
## agreeableness_Respectfulness.Ord1 0.12950398
## agreeableness_Trust.Ord1 -0.18502952
## conscientiousness_Organization.Ord1 -0.35086093
## conscientiousness_Productiveness.Ord1 0.07207468
## conscientiousness_Responsibility.Ord1 -0.19675725
## extraversion_Assertiveness.Ord1 0.09439041
## extraversion_Energy.Level.Ord1 -0.02092129
## extraversion_Sociability.Ord1 -0.32413153
## neuroticism_Anxiety.Ord1 0.41431030
## neuroticism_Depression.Ord1 1.00000000
## neuroticism_Emotional.Volatility.Ord1 0.45415488
## openness_Aesthetic.Sensitivity.Ord1 -0.18675038
## openness_Creative.Imagination.Ord1 -0.06386812
## openness_Intellectual.Curiosity.Ord1 0.10632541
## neuroticism_Emotional.Volatility.Ord1
## agreeableness_Compassion.Ord1 -0.48796058
## agreeableness_Respectfulness.Ord1 0.35952234
## agreeableness_Trust.Ord1 -0.11723343
## conscientiousness_Organization.Ord1 -0.13640695
## conscientiousness_Productiveness.Ord1 -0.11592350
## conscientiousness_Responsibility.Ord1 -0.08387357
## extraversion_Assertiveness.Ord1 -0.35793173
## extraversion_Energy.Level.Ord1 -0.17666250
## extraversion_Sociability.Ord1 -0.06561852
## neuroticism_Anxiety.Ord1 0.31668760
## neuroticism_Depression.Ord1 0.45415488
## neuroticism_Emotional.Volatility.Ord1 1.00000000
## openness_Aesthetic.Sensitivity.Ord1 -0.37696342
## openness_Creative.Imagination.Ord1 -0.15339317
## openness_Intellectual.Curiosity.Ord1 0.06495692
## openness_Aesthetic.Sensitivity.Ord1
## agreeableness_Compassion.Ord1 -0.09444956
## agreeableness_Respectfulness.Ord1 0.12089388
## agreeableness_Trust.Ord1 0.48988811
## conscientiousness_Organization.Ord1 0.26503610
## conscientiousness_Productiveness.Ord1 0.32054748
## conscientiousness_Responsibility.Ord1 0.41801298
## extraversion_Assertiveness.Ord1 0.42602702
## extraversion_Energy.Level.Ord1 0.38957794
## extraversion_Sociability.Ord1 0.14348818
## neuroticism_Anxiety.Ord1 0.06643272
## neuroticism_Depression.Ord1 -0.18675038
## neuroticism_Emotional.Volatility.Ord1 -0.37696342
## openness_Aesthetic.Sensitivity.Ord1 1.00000000
## openness_Creative.Imagination.Ord1 0.13541568
## openness_Intellectual.Curiosity.Ord1 0.28415241
## openness_Creative.Imagination.Ord1
## agreeableness_Compassion.Ord1 0.37458034
## agreeableness_Respectfulness.Ord1 -0.17862193
## agreeableness_Trust.Ord1 0.46349414
## conscientiousness_Organization.Ord1 0.14865374
## conscientiousness_Productiveness.Ord1 0.02839038
## conscientiousness_Responsibility.Ord1 -0.21722840
## extraversion_Assertiveness.Ord1 0.18766602
## extraversion_Energy.Level.Ord1 0.10358889
## extraversion_Sociability.Ord1 0.14793908
## neuroticism_Anxiety.Ord1 0.24200955
## neuroticism_Depression.Ord1 -0.06386812
## neuroticism_Emotional.Volatility.Ord1 -0.15339317
## openness_Aesthetic.Sensitivity.Ord1 0.13541568
## openness_Creative.Imagination.Ord1 1.00000000
## openness_Intellectual.Curiosity.Ord1 -0.03077718
## openness_Intellectual.Curiosity.Ord1
## agreeableness_Compassion.Ord1 0.09744585
## agreeableness_Respectfulness.Ord1 0.54388484
## agreeableness_Trust.Ord1 -0.01800785
## conscientiousness_Organization.Ord1 0.01530440
## conscientiousness_Productiveness.Ord1 0.27137884
## conscientiousness_Responsibility.Ord1 0.68352130
## extraversion_Assertiveness.Ord1 0.12597299
## extraversion_Energy.Level.Ord1 -0.00652038
## extraversion_Sociability.Ord1 -0.14786865
## neuroticism_Anxiety.Ord1 0.14892668
## neuroticism_Depression.Ord1 0.10632541
## neuroticism_Emotional.Volatility.Ord1 0.06495692
## openness_Aesthetic.Sensitivity.Ord1 0.28415241
## openness_Creative.Imagination.Ord1 -0.03077718
## openness_Intellectual.Curiosity.Ord1 1.00000000ega_ind$dynEGA$ID143$mu## NULLega_ind$dynEGA$ID143$lambda## [1] 0.1ega_ind$dynEGA$ID143$dim.variables5.4 Plot the Results
Let’s plot it, shall we? To do this, we’ll use the
qgraph package and my own stylistic preferences.
# now let's wrangle the names of the labels
tnames <- tibble(old = rownames(ega_ind$dynEGA$ID143$network)
, new = paste0(rep(c("A", "C", "E", "N", "O"), each = 1), rep(1:3, times = 5)))
wmat <- ega_ind$dynEGA$ID143$network
colnames(wmat) <- tnames$new; rownames(wmat) <- tnames$new
# first, we need to make a list of the cluster membership
tmp <- ega_ind$dynEGA$ID143$dim.variables %>%
mutate(items = mapvalues(items, tnames$old, tnames$new)) %>%
group_by(dimension) %>%
nest() %>%
ungroup()
mem_list <- tmp$data; names(mem_list) <- tmp$dimension
cols <- RColorBrewer::brewer.pal(length(mem_list), "Set3")
g <- qgraph(
wmat
, color = cols # color based on cluster
, layout = "spring" # force directed algorithm
, border.width = 4 # width of the border around nodes
, vsize = 10 # size of the nodes
, label.font = 2 # make the font bold
, label.fill.vertical = 1 # make sure we use all our space for labels
, negDashed = T # dash negative edges
, edge.color = "black" # make edges black
, edge.labels = T # label the edges
)
plot(g)
title("ID143")
We can also make this a more flexible function and do it for everyone!
tnames <- tibble(old = rownames(ega_ind$dynEGA$ID143$network)
, new = paste0(rep(c("A", "C", "E", "N", "O"), each = 1), rep(1:3, times = 5)))
ega_qgraph_fun <- function(obj, id){
# now let's wrangle the names of the labels
wmat <- obj$network
colnames(wmat) <- tnames$new; rownames(wmat) <- tnames$new
# first, we need to make a list of the cluster membership
tmp <- obj$dim.variables %>%
mutate(items = mapvalues(items, tnames$old, tnames$new)) %>%
group_by(dimension) %>%
nest() %>%
ungroup()
mem_list <- tmp$data; names(mem_list) <- tmp$dimension
cols <- RColorBrewer::brewer.pal(9, "Set3")[1:length(mem_list)]
g <- qgraph(
wmat
, color = cols # color based on cluster
, layout = "spring" # force directed algorithm
, border.width = 4 # width of the border around nodes
, vsize = 10 # size of the nodes
, label.font = 2 # make the font bold
, label.fill.vertical = 1 # make sure we use all our space for labels
, negDashed = T # dash negative edges
, edge.color = "black" # make edges black
, edge.labels = T # label the edges
, mar = c(4,4,5,4) # margins
)
title(id, line = 3)
}
par(mfrow = c(3,4))
tibble(
SID = names(ega_ind$dynEGA)
, network = ega_ind$dynEGA
) %>%
mutate(plot = map2(network, SID, ega_qgraph_fun))
6 Exercise 5: Variance Decomposition with MLM
dat3 <- read_csv(url(sprintf("%s/ESM-structure/blob/main/02-data/02-facet-wide/02-imputed/facet_wide_imp.csv?raw=true", wd))) %>%
group_by(SID) %>%
mutate_at(vars(-Full_Date, -all_beeps), lst(lag = lag)) %>%
ungroup()## Rows: 23615 Columns: 18
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): SID, Full_Date
## dbl (16): agreeableness_Compassion, agreeableness_Respectfulness, agreeablen...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.6.1 Unconditional Model
Level 1:
\(Y_{it} = \beta_{0i} +
\epsilon_{it}\)
Level 2:
\(\beta_{0i} = \mu_{00} + u_{0i}\)
, where \(\beta_{0i}\) is the average value of \(Y\) for person \(i\) across all observations \(t\), \(\mu_{00}\) is the average value of \(Y\) across the full sample, and \(u_{0i}\) is the deviation from the average value of the sample for person \(i\) across all time points \(t\).
And the \(\tau\) matrix is summarized by a single cell, \(\tau_{00}^2\) and \(\sigma^2\) is the squared residuals, \(\epsilon_{it}\).
# run the model
mod0 <- lmer(agreeableness_Compassion ~ 1 + (1 | SID), data = dat3)
# get model term summaries
tidy(mod0, conf.int = T)# examine the Variance-Covariance matrix
VarCorr(mod0)## Groups Name Std.Dev.
## SID (Intercept) 0.24582
## Residual 0.80169# Groups = SID = tau^2
# Residual = sigma^26.1.1 ICC
The intraclass correlation captures the ratio of level 2 units (in this case person-means) to the total variance both across people and within each person:
\(\frac{\tau_{00}^2}{\tau_{00}^2 + \sigma^2}\)
vc <- VarCorr(mod0) %>% as.data.frame(); vcicc <- vc$vcov[1] / (vc$vcov[1] + vc$vcov[2]); icc## [1] 0.085941826.1.2 Distributions
My hot take is that MLM’s should never be run without including either all estimates of level 2 units or a distribution of all of those estimates. We’ll do the latter here.
coef(mod0)$SID %>%
ggplot(aes(x = `(Intercept)`)) +
geom_histogram(aes(y = ..density..), fill = "lightgrey", color = "black") +
geom_density(color = "blue", size = 1) +
labs(x = "Agreeableness: Compassion Person-Mean"
, y = "Density"
, title = "Distribution of Level 2 Units") +
theme_classic() +
theme(plot.title = element_text(hjust = .5, face = "bold"))## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
6.2 Conditional Model
Conditional model just means that we are adjusting the variance
decomposition by adding some covariate to the model. In this case, let’s
look at autoregresion, or using previous time point \(y\) to predict next time point \(y\).
Level 1:
\(Y_{it} = \beta_{0i} + \beta_{1i}*X_{it} +
\epsilon_{it}\)
Level 2:
\(\beta_{0i} = \mu_{00} +
u_{0i}\)
\(\beta_{0i} = \mu_{10} + u_{1i}\)
, where:
- \(\beta_{0i}\) is the average value
of \(Y\) for person \(i\) across all observations \(t\)
- \(\beta_{1i}\) is the
autoregressive relationship of \(Y\)
for person \(i\) across all
observations \(t\)
- \(\mu_{00}\) is the average value
of \(Y\) across the full sample
- \(\mu_{10}\) is the average
autoregressive relationship of \(Y\)
across the full sample
- \(u_{0i}\) is the deviation from
the average value of the sample for person \(i\) across all time points \(t\).
- \(u_{1i}\) is the deviation from the average autoregressive relationship for person \(i\) across all time points \(t\).
mod1 <- lmer(agreeableness_Compassion ~ 1 + agreeableness_Compassion_lag + ( 1 + agreeableness_Compassion_lag | SID)
, data = dat3); mod1## Linear mixed model fit by REML ['lmerMod']
## Formula: agreeableness_Compassion ~ 1 + agreeableness_Compassion_lag +
## (1 + agreeableness_Compassion_lag | SID)
## Data: dat3
## REML criterion at convergence: 12509.97
## Random effects:
## Groups Name Std.Dev. Corr
## SID (Intercept) 0.29114
## agreeableness_Compassion_lag 0.06579 -0.60
## Residual 0.80034
## Number of obs: 5126, groups: SID, 188
## Fixed Effects:
## (Intercept) agreeableness_Compassion_lag
## 3.35972 0.05038td1 <- tidy(mod1, conf.int = T); td1There was a small carry-over association between previous and current time point compassion (\(\mu_{10}\) = 0.05, 95% CI = [0.02, 0.08]).
6.2.1 Distributions
Here, we need to plot two random effects, the average level and teh average lagged association.
coef(mod1)$SID %>%
rownames_to_column("id") %>%
pivot_longer(
cols = -id
, names_to = "term"
, values_to = "est"
) %>%
mutate(term = mapvalues(term, c("(Intercept)", "agreeableness_Compassion_lag"), c("Person-Mean Compassion", "Person-Specific Lagged Association"))) %>%
ggplot(aes(x = est)) +
geom_histogram(aes(y = ..density..), fill = "lightgrey", color = "black") +
geom_density(color = "blue", size = 1) +
facet_grid(~term, scales = "free") +
labs(x = "Empirical Bayes Estimate"
, y = "Density"
, title = "Distribution of Level 2 Units") +
theme_classic() +
theme(plot.title = element_text(hjust = .5, face = "bold"))## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
6.3 Add Time-Varying Covariate / Predictor
Level 1:
\(Y_{it} = \beta_{0i} + \beta_{1i}*y_{it-1} +
\beta_{2i}*X_{it} + \epsilon_{it}\)
Level 2:
\(\beta_{0i} = \mu_{00} +
u_{0i}\)
\(\beta_{1i} = \mu_{10} +
u_{1i}\)
\(\beta_{2i} = \mu_{20} + u_{1i}\)
, where:
- \(\mu_{00}\) = average level of
\(Y\) across people \(i\) and time points \(t\).
- \(\mu_{10}\) is the average
autoregressive relationship of \(Y\)
across the full sample.
- \(\mu_{20}\) = average association
between \(X\) and \(Y\) across the full sample.
- \(\beta_{0i}\) = average levels of
\(Y\) for person \(i\).
- \(\beta_{1i}\) is the
autoregressive relationship of \(Y\)
for person \(i\) across all
observations \(t\).
- \(\beta_{2i}\) = average assocation
between \(X\) and \(Y\) for person \(i\) across time points \(t\).
- \(u_{0i}\) = deviations from
average levels of \(Y\) for person
\(i\).
- \(u_{1i}\) is the deviation from
the average autoregressive relationship for person \(i\) across all time points \(t\).
- \(u_{2i}\) is the deviation from the average \(XY\) association for person \(i\) across all time points \(t\).
mod2 <- lmer(agreeableness_Compassion ~ 1 + agreeableness_Compassion_lag + extraversion_Sociability +
( 1 + agreeableness_Compassion_lag + extraversion_Sociability | SID)
, data = dat3); mod2## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.00955907 (tol = 0.002, component 1)## Linear mixed model fit by REML ['lmerMod']
## Formula: agreeableness_Compassion ~ 1 + agreeableness_Compassion_lag +
## extraversion_Sociability + (1 + agreeableness_Compassion_lag +
## extraversion_Sociability | SID)
## Data: dat3
## REML criterion at convergence: 12365.16
## Random effects:
## Groups Name Std.Dev. Corr
## SID (Intercept) 0.14730
## agreeableness_Compassion_lag 0.06595 -0.69
## extraversion_Sociability 0.03845 0.99 -0.59
## Residual 0.78993
## Number of obs: 5126, groups: SID, 188
## Fixed Effects:
## (Intercept) agreeableness_Compassion_lag
## 2.97919 0.04667
## extraversion_Sociability
## 0.12424
## optimizer (nloptwrap) convergence code: 0 (OK) ; 0 optimizer warnings; 1 lme4 warningstd2 <- tidy(mod2, conf.int = T); td2There was a concurrent association between sociability and compassion, even when accounting for previous compassion (\(\mu_{20}\) = 0.12, 95% CI [0.10, 0.15]). Moreover, even when accounting for concurrent sociability, the carry-over association of compassion remained ($_{10} = 0.05, 95% CI [0.02, 0.08]).
6.3.1 Distributions
Here, we need to plot three random effects, the average level, the average lagged association, the sociability-compassion association.
coef(mod2)$SID %>%
rownames_to_column("id") %>%
pivot_longer(
cols = -id
, names_to = "term"
, values_to = "est"
) %>%
mutate(term = mapvalues(term, c("(Intercept)", "agreeableness_Compassion_lag", "extraversion_Sociability")
, c("Person-Mean Compassion", "Person-Specific Lagged Association", "Person-Specific\n Sociability-Compassion Association"))) %>%
ggplot(aes(x = est)) +
geom_histogram(aes(y = ..density..), fill = "lightgrey", color = "black") +
geom_density(color = "blue", size = 1) +
facet_grid(~term, scales = "free") +
labs(x = "Empirical Bayes Estimate"
, y = "Density"
, title = "Distribution of Level 2 Units") +
theme_classic() +
theme(plot.title = element_text(hjust = .5, face = "bold"))## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
6.4 Add Time-Invariant Covariate / Predictor
Level 1:
\(Y_{it} = \beta_{0i} +
\beta_{1i}*(X_{it}-\bar{X}_{i}) + \epsilon_{it}\)
Level 2:
\(\beta_{0i} = \mu_{00} +
\mu_{01}*(\bar{X}_{i} - \bar{X}) + u_{0i}\)
\(\beta_{1i} = \mu_{10} +
\mu_{11}*(\bar{X}_{i} - \bar{X}) + u_{1i}\)
, where:
- \(\mu_{10}\) = average change in
\(Y\) as a function of deviations from
within-person averages of \(X\) across
people \(i\) and time points \(t\).
- \(\mu_{01}\) = average change in
\(Y\) as a function of between person
differences in average levels of \(X\)
across people \(i\) and time points
\(t\).
- \(\mu_{11}\) = average change in
\(Y\) as a function of both
within-person deviations from person-level means and between-person
differences average levels of \(X\)
across people \(i\) and time points
\(t\).
- \(\beta_{0i}\) = average levels of
\(Y\) for person \(i\) across time points \(t\).
- \(\beta_{1i}\) = average change in
\(Y\) as a function of within-person
deviations in \(X\) for person \(i\) across time points \(t\).
- \(u_{0i}\) = deviations from
average levels of \(Y\) for person
\(i\) across time points \(t\).
- \(u_{1i}\) = deviations in change in \(Y\) as a function of deviations in within-person levels of \(X\) for person \(i\) across time points \(t\).
dat3a <- dat3 %>%
# keep only necessary variables
select(SID, all_beeps, agreeableness_Compassion, agreeableness_Compassion_lag, extraversion_Sociability, all_beeps) %>%
# group by person to get person-specific means
group_by(SID) %>%
# person-mean centered sociability -- used in model
mutate(extraversion_Sociability_c = extraversion_Sociability - mean(extraversion_Sociability, na.rm = T)
# person average sociability -- not used in model
, extraversion_Sociability_m = mean(extraversion_Sociability, na.rm = T)) %>%
ungroup() %>%
# grand mean centered person means -- used in model
mutate(extraversion_Sociability_gmc = extraversion_Sociability_m - mean(extraversion_Sociability_m))
# run the model
mod3 <- lmer(agreeableness_Compassion ~ 1 + extraversion_Sociability_c + extraversion_Sociability_gmc + extraversion_Sociability_c:extraversion_Sociability_gmc +
(1 + extraversion_Sociability_c | SID), data = dat3a); mod3## Linear mixed model fit by REML ['lmerMod']
## Formula:
## agreeableness_Compassion ~ 1 + extraversion_Sociability_c + extraversion_Sociability_gmc +
## extraversion_Sociability_c:extraversion_Sociability_gmc +
## (1 + extraversion_Sociability_c | SID)
## Data: dat3a
## REML criterion at convergence: 20825.05
## Random effects:
## Groups Name Std.Dev. Corr
## SID (Intercept) 0.20193
## extraversion_Sociability_c 0.02567 0.44
## Residual 0.79106
## Number of obs: 8673, groups: SID, 199
## Fixed Effects:
## (Intercept)
## 3.50554
## extraversion_Sociability_c
## 0.11146
## extraversion_Sociability_gmc
## 0.36405
## extraversion_Sociability_c:extraversion_Sociability_gmc
## 0.06265td3 <- tidy(mod3, conf.int = T); td3Higher sociability than usual for an individual is associated with more compassion, on average (\(\mu_{10}\) = 0.11, 95% CI [0.10, 0.13]). People with higher sociability, on average, were also more compassionate (\(\mu_{01}\) = 0.36, 95% CI [0.28, 0.45]). Finally, there was interaction between average sociability and deviations of sociability (\(\mu_{11}\) = 0.06, 95% CI [0.02, 0.10]), such that for individuals who were higher in sociability than others, they were even more compassionate when they were more sociable than usual relative to individuals lower in sociability than others.
6.4.1 Distributions
Here, we need to plot two random effects, the average level and the association between deviations from person-means in sociability and deviations in compassion.
coef(mod3)$SID %>%
rownames_to_column("id") %>%
select(-extraversion_Sociability_gmc, -`extraversion_Sociability_c:extraversion_Sociability_gmc`) %>%
pivot_longer(
cols = -id
, names_to = "term"
, values_to = "est"
) %>%
mutate(term = mapvalues(term, c("(Intercept)", "extraversion_Sociability_c"), c("Person-Mean Compassion", "Person-Specific Sociability-Compassion Association"))) %>%
ggplot(aes(x = est)) +
geom_histogram(aes(y = ..density..), fill = "lightgrey", color = "black") +
geom_density(color = "blue", size = 1) +
facet_grid(~term, scales = "free") +
labs(x = "Empirical Bayes Estimate"
, y = "Density"
, title = "Distribution of Level 2 Units") +
theme_classic() +
theme(plot.title = element_text(hjust = .5, face = "bold"))## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
6.5 Growth Models
6.5.1 Data
These data come from the National Longitudinal Studies of Youth, Children and Young Adults Sample and were used in Bollich, Beck, Hill, and Jackson (2021) to estimate trajectories of four individual difference characteristics depending on whether adolescents had contact with the criminal justice system or not.
load(url("https://github.com/emoriebeck/R-tutorials/blob/master/11-ggplot-p3-mlm/data/sample.RData?raw=true"))
sample_datAt its simplest, a growth model is just a basic MLM with a
time-varying covariate (where the time-varying covariate is itself
time).
Level 1:
\(Y_{it} = \beta_{0i} + \beta_{1i}*time_{it} +
\epsilon_{it}\)
Level 2:
\(\beta_{0i} = \mu_{00} +
u_{0i}\)
\(\beta_{1i} = \mu_{10} + u_{1i}\)
, where:
- \(\mu_{10}\) = average change in
\(Y\) as a function of deviations from
within-person averages of \(X\) across
people \(i\) and time points \(t\).
- \(\beta_{0i}\) = average levels of
\(Y\) for person \(i\) at time 0.
- \(\beta_{1i}\) = average slope /
change in \(Y\) for person \(i\) across time points \(t\).
- \(u_{0i}\) = deviations from
average levels of \(Y\) at wave 0 for
person \(i\).
- \(u_{1i}\) = deviations in slope / change in \(Y\) for person \(i\) across time points \(t\).
mod4 <- lmer(CESD ~ 1 + age0 + ( 1 + age0 | PROC_CID), data = sample_dat); mod4## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.00354122 (tol = 0.002, component 1)## Linear mixed model fit by REML ['lmerMod']
## Formula: CESD ~ 1 + age0 + (1 + age0 | PROC_CID)
## Data: sample_dat
## REML criterion at convergence: 3436.366
## Random effects:
## Groups Name Std.Dev. Corr
## PROC_CID (Intercept) 0.35986
## age0 0.04852 -0.50
## Residual 0.45018
## Number of obs: 2084, groups: PROC_CID, 924
## Fixed Effects:
## (Intercept) age0
## 0.702309 0.007357
## optimizer (nloptwrap) convergence code: 0 (OK) ; 0 optimizer warnings; 1 lme4 warningstd4 <- tidy(mod4, conf.int = T); td4Overall, there was no significant change in Sensation Seeking across adolescence (\(\mu_{10}\) = 0.007, 95% CI [-0.0003, 0.02]).
6.5.2 Distributions
Here, we need to plot two random effects, the average level at age 14 and the slope.
coef(mod4)$PROC_CID %>%
rownames_to_column("id") %>%
pivot_longer(
cols = -id
, names_to = "term"
, values_to = "est"
) %>%
mutate(term = mapvalues(term, c("(Intercept)", "age0")
, c("CESD at Age 14", "Person-Specific Slope"))) %>%
ggplot(aes(x = est)) +
geom_histogram(aes(y = ..density..), fill = "lightgrey", color = "black") +
geom_density(color = "blue", size = 1) +
facet_grid(~term, scales = "free") +
labs(x = "Empirical Bayes Estimate"
, y = "Density"
, title = "Distribution of Level 2 Units") +
theme_classic() +
theme(plot.title = element_text(hjust = .5, face = "bold"))## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
6.6 Mega-Analysis
At its most basic form, a mega-analysis is just a basic multilevel model with a Level 1 covariate. The difference is that it’s no longer observations across time nested within people. Instead its people nested within samples with samples as the grouping variable.
Level 1:
\(Y_{is} = \beta_{0s} + \beta_{2s}*X_{is} +
\epsilon_{is}\)
Level 2:
\(\beta_{0i} = \gamma_{00} +
u_{0i}\)
\(\beta_{1s} = \gamma_{10} +
u_{1s}\)
, where:
- \(\gamma_{00}\) = average level of
\(Y\) across people \(i\) and samples \(t\).
- \(\gamma_{10}\) = average
association between \(X\) and \(Y\) across all samples (the “mega-analytic”
association).
- \(\beta_{0s}\) = average levels of
\(Y\) for sample \(s\).
- \(\beta_{1s}\) = average
association between \(X\) and \(Y\) for sample \(s\) across people \(i\).
- \(u_{0s}\) = deviations from
average levels of \(Y\) for sample
\(s\).
- \(u_{1s}\) is the deviation from the average \(XY\) association for sample \(s\) across all people \(i\).
6.6.1 Data
These data come from a yet-unpublished project examining 8 methods for synthesizing data via individual-participants meta-analysis, including meta-analysis. The data come from many samples, but all information on those samples has been scrubbed from the data we’ll be using and it will only be a relatively small sub-sample of the population (500 from each sample). Specifically, this data set examines the association bewteen Conscientiousness and episodic memory across 10 samples.
load(url("https://github.com/emoriebeck/R-tutorials/blob/master/99_archive/sample-mega-analysis.RData?raw=true"))
dmod5 <- lmer(o_value ~ 1 + p_value + ( 1 + p_value | study), data = d); mod5## Linear mixed model fit by REML ['lmerMod']
## Formula: o_value ~ 1 + p_value + (1 + p_value | study)
## Data: d
## REML criterion at convergence: 21623.18
## Random effects:
## Groups Name Std.Dev. Corr
## study (Intercept) 2.119
## p_value 0.120 -0.68
## Residual 2.087
## Number of obs: 5000, groups: study, 10
## Fixed Effects:
## (Intercept) p_value
## 5.1446 0.1014td5 <- tidy(mod5, conf.int = T); td5Overall, there was a significant association between Conscientiousness and Episodic Memory across samples (\(\gammau_{10}\) = 0.10, 95% CI [0.02, 0.18]).
6.6.2 Distributions
Rather than distributions, we are going to look at forest plots of the intercepts and personality-outcome associations because this is more typical in meta/mega-analysis.
fp_dat <- coef(mod5)$study %>%
data.frame() %>%
rownames_to_column("study") %>%
mutate(term = "estimate") %>%
full_join(
parameters::standard_error(mod5, effects = "random")$study %>%
data.frame() %>%
rownames_to_column("study") %>%
mutate(term = "SE")) %>%
rename(Intercept = X.Intercept.) %>%
# select(study, term, , p_value) %>%
pivot_longer(c(-study, -term), names_to = "names", values_to = "estimate") %>%
pivot_wider(names_from = "term", values_from = "estimate") %>%
rename(term = names) %>%
mutate(conf.low = estimate - 2*SE, conf.high = estimate + 2*SE,
term = ifelse(grepl("p_value.", term), str_replace_all(term, "p_value.", "p_value:"), term)) %>%
full_join(
td5 %>%
filter(effect == "fixed") %>%
select(term, estimate, conf.low, conf.high) %>%
mutate(study = "Overall", term = str_replace(term, "\\(Intercept\\)", "Intercept"))
)## Joining, by = c("study", "X.Intercept.", "p_value", "term")
## Joining, by = c("study", "term", "estimate", "conf.low", "conf.high")## arrange by effect size
std_levs <- (fp_dat %>%
filter(study != "Overall" & term == "p_value") %>%
arrange(estimate))$study
fp_dat %>%
filter(term == "p_value") %>%
mutate(study = factor(study, c("Overall", std_levs))) %>%
ggplot(aes(x = study, y = estimate)) +
geom_errorbar(aes(ymin = conf.low, ymax = conf.high)
, position = "dodge"
, width = .1) +
geom_hline(aes(yintercept = 0), linetype = "dashed", size = .7) +
geom_point() +
coord_flip() +
theme_classic() 
Honestly, this isn’t a super-satisfactory forest plot, but much better examples can be found at https://github.com/emoriebeck/data-synthesis-tutorial and seen on https://emoriebeck.shinyapps.io/data-synthesis-tutorial.
7 Miscellaneous
7.1 Fake Data for EGA Slides
id <- rep(1, 16)
x1 <- c(3, 2, 3, 3, 2, 5, 4, 5, 2, 4, 4, 3, 4, 2, 2, 4)
x2 <- c(3, 2, 1, 4, 3, 4, 3, 2, 3, 2, 3, 2, 4, 2, 1, 3)
x3 <- c(4, 1, 1, 4, 3, 1, 2, 4, 3, 3, 2, 3, 1, 2, 1, 0)
x4 <- c(3, 4, 3, 3, 3, 4, 1, 4, 2, 1, 4, 2, 4, 4, 2, 4)
x5 <- c(3, 2, 4, 3, 3, 1, 2, 3, 3, 3, 0, 2, 4, 3, 2, 4)
x <- cbind(x1, x2, x3, x4, x5)
r <- round(apply(x, 2, function(i) glla(i, n.embed = 5, tau = 1, delta = 4, order = 1)[,2]), 2)
g <- qgraph(cor_auto(r)
, layout = "spring"
, graph = "glasso"
, sampleSize = 100
, color = c("#302ef9", "#ec7d32", "#ffbf00", "#00b050", "#70309f")
, vsize = 15
, border.width = 4
# , labels = c("x_1*", "delta x1*", "delta x1*", "delta x1*", "delta x1*")
, label.color = "white"
, label.font = 2
, label.fill.vertical = 1
, edge.color = "black")
g$graphAttributes$Edges$lty[g$Edgelist$weight < 0] <- 2
# png(filename = "~/Downloads/plot.png", width = 1000, height = 1000)
plot(g)
# dev.off()
pr <- getWmat(g)
x <- as.data.frame(cbind(id, x1, x2, x3, x4, x5))
dx <- dynEGA(x, n.embed = 5, level = "individual", model = "glasso", id = 1, delta = 4, order = 1)##
## Computing derivatives using GLLA...## Estimating the dimensionality structure using EGA...## Level: Individual (Intraindividual Structure)...## done